home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / javaMode.tcl < prev    next >
Encoding:
Text File  |  1997-12-10  |  7.7 KB  |  238 lines  |  [TEXT/ALFA]
  1. alpha::mode Java 1.0 javaMenu {*.java *.j} javaMenu {
  2.     addMenu    javaMenu "•140"
  3. }
  4.  
  5. newPref    f elecColon {1} Java
  6. newPref    f elecRBrace {1} Java
  7. newPref    v leftFillColumn {3} Java
  8. newPref    v prefixString {//} Java 
  9. newPref    f electricSemi {1} Java
  10. newPref    f elecLBrace {1} Java
  11. newPref    f wordWrap {0} Java
  12. newPref    v funcExpr {^[^ \t\(#\r/@].*\(.*\)$} Java
  13. newPref    v parseExpr {\b([_:\w]+)\s*\(} Java
  14. newPref    v wordBreak {\w+} Java
  15. newPref    v wordBreakPreface {\W} Java
  16. newPref    f electricTab {0} Java
  17. newPref    f autoMark    0 Java
  18. newPref    v stringColor    green Java
  19. newPref    v commentColor    red     Java
  20. newPref    v keywordColor    blue Java
  21. newPref f includeMenu 1 Java
  22.  
  23. regModeKeywords     -e {//} -b {/*} {*/} -c $JavamodeVars(commentColor) -k    $JavamodeVars(keywordColor)  -s    $JavamodeVars(stringColor) Java    {
  24.     abstract boolean break byte byvalue case catch char class const 
  25.     continue default do double else extends false final finally float for 
  26.     goto if implements import instanceof int interface long native new 
  27.     null package private protected public return short static super switch 
  28.     synchronized this throw throws transient true try void while future 
  29.     generic inner outer operator rest var volatile
  30. }
  31.  
  32. proc javaMenu {} {}
  33.  
  34. ## 
  35.  # -------------------------------------------------------------------------
  36.  # 
  37.  # "menu::buildjavaMenu" --
  38.  # 
  39.  #  Use a build proc so we can add things on the fly.
  40.  # -------------------------------------------------------------------------
  41.  ##
  42. proc menu::buildjavaMenu {} {
  43.     global javaMenu
  44.     set ma {
  45.         "/S<U<OswitchToCompiler"
  46.         "(-"
  47.         "/K<U<OcompileFile"
  48.         "(-"
  49.         "/V<U<OviewApplet"
  50.     }
  51.     return [list build $ma Java::MenuProc "" $javaMenu]
  52. }
  53. menu::buildProc javaMenu menu::buildjavaMenu
  54.  
  55. # If this package exists, add the headers menu
  56. if [alpha::package exists -extension modeSearchPaths] {
  57.     menu::buildProc javaHeaders {mode::rebuildSearchPathMenu javaHeaders}
  58.     menu::insert javaMenu submenu end javaHeaders
  59. }
  60.  
  61. menu::buildSome javaMenu
  62.  
  63. proc Java::MenuProc {menu item} {
  64.     eval Java::$item
  65. }
  66.  
  67. # Launches Java Compiler
  68. proc Java::switchToCompiler {} {
  69.     global javacompilerSig
  70.     app::launchAnyOfThese Javc javacompilerSig "Please locate the Java compiler:"
  71.     switchTo '$javacompilerSig'
  72. }
  73.  
  74. # Sends the window to the compiler.
  75. proc Java::compileFile {} {
  76.     global javacompilerSig
  77.     set path [stripNameCount [win::Current]]
  78.  
  79.     if {[winDirty]} {
  80.         case [askyesno -c "Save '[file tail $path]'?"] in {
  81.             "yes" {save}
  82.             "no" {
  83.                 if {![file exists $path]} {alertnote "Can't send window to compiler."; return}
  84.             }
  85.             "cancel" {return}
  86.         }
  87.     }
  88.     # Get path again, in case it was Untitled before.
  89.     set path [stripNameCount [win::Current]]
  90.     app::launchAnyOfThese Javc javacompilerSig "Please locate the Java compiler:"
  91.     sendOpenEvent -n '$javacompilerSig' $path
  92.     switchTo '$javacompilerSig'
  93. }
  94.  
  95. # Opens a HTML file corresponding to a java file in the Applet Viewer.
  96. # If there is a file some_applet.html in the same folder as some_applet.java
  97. # it is sent. Otherwise the user is asked to select a HTML file.
  98. # This file is remembered throughout this session with Alpha.
  99. proc Java::viewApplet {} {
  100.     global javaAppletFile javaviewerSig
  101.     set name [stripNameCount [win::Current]]
  102.     set dir [file dirname $name]
  103.     set root [file rootname [file tail $name]]
  104.     set path "$dir:$root.html"
  105.     if {[info exists javaAppletFile($name)] && [file exists $javaAppletFile($name)]} {
  106.         set path $javaAppletFile($name)
  107.     } elseif {![file exists $path]} {
  108.         set path [getfile "Please locate HTML file for applet."]
  109.         set javaAppletFile($name) $path
  110.     }
  111.     app::launchAnyOfThese [list AppV WARZ] javaviewerSig "Please locate the Applet viewer:"
  112.     sendOpenEvent noReply '$javaviewerSig' $path
  113.     switchTo '$javaviewerSig'
  114. }
  115.  
  116. proc Java::MarkFile {} {
  117.     Java::MarkFile2 1
  118. }
  119.  
  120. proc Java::parseFuncs {} {
  121.     Java::MarkFile2 0
  122. }
  123.  
  124.  
  125. # My version of    Java::MarkFile. First revision, April 1996.
  126. # Jim Menard, jimm@io.com
  127. proc Java::MarkFile2 {marking} {
  128.     # Sorry, but globals are a lot easier than using "upvar" in subroutines
  129.     global markArray
  130.     global classStartPositions
  131.     global classNames
  132.  
  133.     catch {    unset markArray    }
  134.  
  135.     # Look for class definitions first
  136.     set markExpr {^[ \t]*([A-Za-z_][A-Za-z0-9_]*[ \t]+)*class[ \t]+[A-Za-z_][A-Za-z0-9_]*[ \t\r]([A-Za-z_][A-Za-z0-9_.]*[ \t]+)*\{}
  137.     set wordExpr {class[ \t]+([A-Za-z_][A-Za-z0-9_]*)}
  138.     set commands {
  139.         set markArray([concat $word "class"]) $markPos
  140.         # Remember mark    position and name separately so    we can call
  141.         # Java::getClassFromPos() later.
  142.         lappend    classStartPositions $markPos
  143.         lappend    classNames $word
  144.     }
  145.     Java::searchAndDestroy $markExpr $wordExpr $commands 0
  146.  
  147.     # The following    regular    expression is overly restrictive. After    the open
  148.     # paren, I disallow semicolons.    That avoids finding lines like
  149.     #    throw new FooException(arg);
  150.     # which    is good, but unfortunately also    avoids finding lines like
  151.     #    public int foo(arg) // comment with semi;
  152.     #
  153.     # It doesn't find constructors without a "public", "private", or other phrase
  154.     # before the method name since it requires at least one    word before the
  155.     # method name. They are    special-cased below. I did that    so function calls,
  156.     # "if" statements, and the like    wouldn't be found.
  157.     set markExpr {^[ \t]*([A-Za-z_][A-Za-z0-9_]*(\[\])*[ \t]+)+[A-Za-z_][A-Za-z0-9_]*[ \t\r]*\([^;]+$}
  158.     set wordExpr {([A-Za-z_][A-Za-z0-9_]*)[    \t]*\(}
  159.     set commands {
  160.         if {$className == $word} {
  161.             set markArray([concat $className "constructor"]) $markPos
  162.         } else {
  163.             set markArray(${className}::$word) $markPos
  164.         }
  165.     }
  166.     Java::searchAndDestroy $markExpr $wordExpr $commands 1
  167.  
  168.     # One more time; let's go back for constructors    with no    modifiers.
  169.     set markExpr {^[ \t]*[A-Za-z][A-Za-z0-9_]*[ \t\r]*\([^;]+$}
  170.     set wordExpr {([A-Za-z][A-Za-z0-9_]*)[ \t]*\(}
  171.     set commands {
  172.         if {$className == $word} {
  173.             set markArray([concat $className "constructor"]) [lineStart [expr $start - 1]]
  174.         }
  175.     }
  176.     Java::searchAndDestroy $markExpr $wordExpr $commands 1
  177.  
  178.     if {[info exists markArray]} {
  179.         foreach    f [lsort -ignore [array    names markArray]] {
  180.             set next [nextLineStart    $markArray($f)]
  181.  
  182.             if {[regexp {.*(::if)$}    $f] == 0} {
  183.                 if {[string length $f] > 35} { set f "[string range $f 0 31]..." }
  184.                 if {$marking} {
  185.                     setNamedMark "${f}" "$markArray($f)" $next $next
  186.                 } else {
  187.                     lappend parse $f $next
  188.                 }
  189.             }
  190.         }
  191.     }
  192.     if {!$marking} {return $parse}
  193. }
  194.  
  195. # Start    at top of file and find    text that matches markExpr. Clean it up    and
  196. # use wordExpr to find the word    we want. Execute commands.
  197. proc Java::searchAndDestroy {markExpr wordExpr commands needClassName} {
  198.     global markArray
  199.     global classStartPositions
  200.     global classNames
  201.  
  202.     set pos    0
  203.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 "$markExpr" $pos}    res]} {
  204.         set start [lindex $res 0]
  205.         set end    [expr [lindex $res 1] +    1]
  206.         set thistext [getText $start $end]
  207.         if {$needClassName} {
  208.             set className [Java::getClassFromPos $start $classStartPositions $classNames]
  209.         }
  210.         # regexp doesn't like carriage returns or tabs
  211.         regsub -all "\r" $thistext " " thistext
  212.         regsub -all "\t" $thistext " " thistext
  213.         # If the open paren was    the last character on the line,
  214.         # the selected text included the last carriage return as well.
  215.         # Trim this off    now that it is changed into a space.
  216.         set thistext [string trimright $thistext]
  217.         if {[regexp $wordExpr $thistext    dummy word]} {
  218.             set markPos [lineStart [expr $start - 1]]
  219.             eval $commands
  220.         }
  221.         set pos    $end
  222.     }
  223. }
  224.  
  225. # Given    a file position, find the class    definition in which it resides.
  226. # There's got to be an easier way than passing two separate lists. I tried fooling
  227. # around with markArray(), but don't know Tcl well enough to use it instead.
  228. proc Java::getClassFromPos {pos classStartPositions classNames} {
  229.     set nClasses [llength $classStartPositions]
  230.     for {set i [expr $nClasses - 1]} {$i >=    0} {set    i [expr    $i - 1]} {
  231.         if {[lindex $classStartPositions $i] <=    $pos} {
  232.             return [lindex $classNames $i]
  233.         }
  234.     }
  235.     return ""
  236. }
  237.  
  238.